home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / iconalb / iconbook.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-10-17  |  23.1 KB  |  682 lines
  1. VERSION 4.00
  2. Begin VB.Form IconBook 
  3.    AutoRedraw      =   -1  'True
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "IconAlbum Deluxe"
  6.    ClientHeight    =   8595
  7.    ClientLeft      =   570
  8.    ClientTop       =   210
  9.    ClientWidth     =   11175
  10.    Height          =   9000
  11.    Icon            =   "IconBook.frx":0000
  12.    Left            =   510
  13.    LinkTopic       =   "Form1"
  14.    MaxButton       =   0   'False
  15.    MinButton       =   0   'False
  16.    ScaleHeight     =   573
  17.    ScaleMode       =   3  'Pixel
  18.    ScaleWidth      =   745
  19.    Top             =   -135
  20.    Width           =   11295
  21.    Begin VB.Frame Frame1 
  22.       BackColor       =   &H00C0C0C0&
  23.       Caption         =   "Selected Icon"
  24.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  25.          Name            =   "MS Sans Serif"
  26.          Size            =   9.75
  27.          Charset         =   0
  28.          Weight          =   700
  29.          Underline       =   -1  'True
  30.          Italic          =   0   'False
  31.          Strikethrough   =   0   'False
  32.       EndProperty
  33.       ForeColor       =   &H000000C0&
  34.       Height          =   2400
  35.       Left            =   0
  36.       TabIndex        =   5
  37.       Top             =   4815
  38.       Width           =   2505
  39.       Begin VB.PictureBox Pic3 
  40.          BackColor       =   &H00C0C0C0&
  41.          BorderStyle     =   0  'None
  42.          Height          =   480
  43.          Left            =   225
  44.          ScaleHeight     =   32
  45.          ScaleMode       =   3  'Pixel
  46.          ScaleWidth      =   32
  47.          TabIndex        =   8
  48.          Top             =   930
  49.          Width           =   480
  50.       End
  51.       Begin VB.Shape Shape2 
  52.          BackColor       =   &H00E0E0E0&
  53.          BorderColor     =   &H00008000&
  54.          BorderWidth     =   3
  55.          Height          =   1050
  56.          Left            =   960
  57.          Shape           =   5  'Rounded Square
  58.          Top             =   750
  59.          Width           =   1110
  60.       End
  61.       Begin VB.Label Label4 
  62.          Alignment       =   2  'Center
  63.          BackColor       =   &H00C0C0C0&
  64.          ForeColor       =   &H00C00000&
  65.          Height          =   240
  66.          Left            =   135
  67.          TabIndex        =   7
  68.          Top             =   360
  69.          Width           =   1995
  70.       End
  71.       Begin VB.Image Image1 
  72.          Height          =   990
  73.          Left            =   1020
  74.          Stretch         =   -1  'True
  75.          Top             =   765
  76.          Width           =   960
  77.       End
  78.       Begin VB.Shape Shape1 
  79.          BackColor       =   &H00E0E0E0&
  80.          BorderColor     =   &H00008000&
  81.          BorderWidth     =   3
  82.          Height          =   645
  83.          Left            =   165
  84.          Shape           =   5  'Rounded Square
  85.          Top             =   840
  86.          Width           =   645
  87.       End
  88.       Begin VB.Label Label3 
  89.          Alignment       =   2  'Center
  90.          BackColor       =   &H00008000&
  91.          BorderStyle     =   1  'Fixed Single
  92.          ForeColor       =   &H0080FFFF&
  93.          Height          =   285
  94.          Left            =   45
  95.          TabIndex        =   6
  96.          Top             =   1935
  97.          Width           =   2355
  98.       End
  99.    End
  100.    Begin VB.PictureBox Pic2 
  101.       AutoRedraw      =   -1  'True
  102.       BackColor       =   &H00C0C0C0&
  103.       Height          =   7980
  104.       Left            =   2580
  105.       ScaleHeight     =   528
  106.       ScaleMode       =   3  'Pixel
  107.       ScaleWidth      =   567
  108.       TabIndex        =   2
  109.       Top             =   555
  110.       Width           =   8565
  111.       Begin VB.Image Im1 
  112.          Height          =   480
  113.          Index           =   0
  114.          Left            =   45
  115.          Top             =   45
  116.          Visible         =   0   'False
  117.          Width           =   480
  118.       End
  119.    End
  120.    Begin VB.DirListBox Dir1 
  121.       BackColor       =   &H00E0E0E0&
  122.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  123.          Name            =   "MS Sans Serif"
  124.          Size            =   8.25
  125.          Charset         =   0
  126.          Weight          =   700
  127.          Underline       =   0   'False
  128.          Italic          =   0   'False
  129.          Strikethrough   =   0   'False
  130.       EndProperty
  131.       ForeColor       =   &H00800000&
  132.       Height          =   3630
  133.       Left            =   0
  134.       TabIndex        =   1
  135.       Top             =   555
  136.       Width           =   2490
  137.    End
  138.    Begin VB.FileListBox File1 
  139.       Height          =   3375
  140.       Left            =   2520
  141.       Pattern         =   "*.ico"
  142.       TabIndex        =   0
  143.       Top             =   3690
  144.       Visible         =   0   'False
  145.       Width           =   1590
  146.    End
  147.    Begin VB.PictureBox ImageList1 
  148.       BackColor       =   &H80000005&
  149.       Height          =   480
  150.       Left            =   450
  151.       ScaleHeight     =   420
  152.       ScaleWidth      =   1140
  153.       TabIndex        =   9
  154.       Top             =   3420
  155.       Width           =   1200
  156.    End
  157.    Begin VB.Image Tool1 
  158.       Height          =   360
  159.       Index           =   6
  160.       Left            =   2385
  161.       Picture         =   "IconBook.frx":0442
  162.       Top             =   45
  163.       Width           =   345
  164.    End
  165.    Begin VB.Image Tool1 
  166.       Height          =   360
  167.       Index           =   5
  168.       Left            =   1935
  169.       Picture         =   "IconBook.frx":05E4
  170.       Top             =   45
  171.       Width           =   345
  172.    End
  173.    Begin VB.Image Tool1 
  174.       Height          =   360
  175.       Index           =   4
  176.       Left            =   1485
  177.       Picture         =   "IconBook.frx":0786
  178.       Top             =   45
  179.       Width           =   345
  180.    End
  181.    Begin VB.Image Tool1 
  182.       Height          =   360
  183.       Index           =   3
  184.       Left            =   1125
  185.       Picture         =   "IconBook.frx":0928
  186.       Top             =   45
  187.       Width           =   345
  188.    End
  189.    Begin VB.Image Tool1 
  190.       Height          =   360
  191.       Index           =   2
  192.       Left            =   765
  193.       Picture         =   "IconBook.frx":0ACA
  194.       Top             =   45
  195.       Width           =   345
  196.    End
  197.    Begin VB.Image Tool1 
  198.       Height          =   360
  199.       Index           =   1
  200.       Left            =   405
  201.       Picture         =   "IconBook.frx":0C6C
  202.       Top             =   45
  203.       Width           =   345
  204.    End
  205.    Begin VB.Image Tool1 
  206.       Height          =   360
  207.       Index           =   0
  208.       Left            =   45
  209.       Picture         =   "IconBook.frx":0E0E
  210.       Top             =   45
  211.       Width           =   345
  212.    End
  213.    Begin VB.Image Image2 
  214.       Height          =   360
  215.       Index           =   13
  216.       Left            =   2160
  217.       Picture         =   "IconBook.frx":0FB0
  218.       Top             =   7830
  219.       Visible         =   0   'False
  220.       Width           =   345
  221.    End
  222.    Begin VB.Image Image2 
  223.       Height          =   360
  224.       Index           =   12
  225.       Left            =   1800
  226.       Picture         =   "IconBook.frx":1152
  227.       Top             =   7830
  228.       Visible         =   0   'False
  229.       Width           =   345
  230.    End
  231.    Begin VB.Image Image2 
  232.       Height          =   360
  233.       Index           =   11
  234.       Left            =   1440
  235.       Picture         =   "IconBook.frx":12F4
  236.       Top             =   7830
  237.       Visible         =   0   'False
  238.       Width           =   345
  239.    End
  240.    Begin VB.Image Image2 
  241.       Height          =   360
  242.       Index           =   10
  243.       Left            =   1080
  244.       Picture         =   "IconBook.frx":1496
  245.       Top             =   7830
  246.       Visible         =   0   'False
  247.       Width           =   345
  248.    End
  249.    Begin VB.Image Image2 
  250.       Height          =   360
  251.       Index           =   9
  252.       Left            =   720
  253.       Picture         =   "IconBook.frx":1638
  254.       Top             =   7830
  255.       Visible         =   0   'False
  256.       Width           =   345
  257.    End
  258.    Begin VB.Image Image2 
  259.       Height          =   360
  260.       Index           =   8
  261.       Left            =   360
  262.       Picture         =   "IconBook.frx":17DA
  263.       Top             =   7830
  264.       Visible         =   0   'False
  265.       Width           =   345
  266.    End
  267.    Begin VB.Image Image2 
  268.       Height          =   360
  269.       Index           =   7
  270.       Left            =   0
  271.       Picture         =   "IconBook.frx":197C
  272.       Top             =   7830
  273.       Visible         =   0   'False
  274.       Width           =   345
  275.    End
  276.    Begin VB.Image Image2 
  277.       Height          =   360
  278.       Index           =   6
  279.       Left            =   2160
  280.       Picture         =   "IconBook.frx":1B1E
  281.       Top             =   7470
  282.       Visible         =   0   'False
  283.       Width           =   345
  284.    End
  285.    Begin VB.Image Image2 
  286.       Height          =   360
  287.       Index           =   5
  288.       Left            =   1800
  289.       Picture         =   "IconBook.frx":1CC0
  290.       Top             =   7470
  291.       Visible         =   0   'False
  292.       Width           =   345
  293.    End
  294.    Begin VB.Image Image2 
  295.       Height          =   360
  296.       Index           =   4
  297.       Left            =   1440
  298.       Picture         =   "IconBook.frx":1E62
  299.       Top             =   7470
  300.       Visible         =   0   'False
  301.       Width           =   345
  302.    End
  303.    Begin VB.Image Image2 
  304.       Height          =   360
  305.       Index           =   3
  306.       Left            =   1080
  307.       Picture         =   "IconBook.frx":2004
  308.       Top             =   7470
  309.       Visible         =   0   'False
  310.       Width           =   345
  311.    End
  312.    Begin VB.Image Image2 
  313.       Height          =   360
  314.       Index           =   2
  315.       Left            =   720
  316.       Picture         =   "IconBook.frx":21A6
  317.       Top             =   7470
  318.       Visible         =   0   'False
  319.       Width           =   345
  320.    End
  321.    Begin VB.Image Image2 
  322.       Height          =   360
  323.       Index           =   1
  324.       Left            =   360
  325.       Picture         =   "IconBook.frx":2348
  326.       Top             =   7470
  327.       Visible         =   0   'False
  328.       Width           =   345
  329.    End
  330.    Begin VB.Image Image2 
  331.       Height          =   360
  332.       Index           =   0
  333.       Left            =   0
  334.       Picture         =   "IconBook.frx":24EA
  335.       Top             =   7470
  336.       Visible         =   0   'False
  337.       Width           =   345
  338.    End
  339.    Begin MSComDlg.CommonDialog ComD1 
  340.       Left            =   1845
  341.       Top             =   6975
  342.       _ExtentX        =   847
  343.       _ExtentY        =   847
  344.       _Version        =   393216
  345.       Flags           =   2
  346.    End
  347.    Begin VB.Label Label2 
  348.       Alignment       =   2  'Center
  349.       BackColor       =   &H00C0C0C0&
  350.       BorderStyle     =   1  'Fixed Single
  351.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  352.          Name            =   "MS Sans Serif"
  353.          Size            =   9.75
  354.          Charset         =   0
  355.          Weight          =   700
  356.          Underline       =   0   'False
  357.          Italic          =   0   'False
  358.          Strikethrough   =   0   'False
  359.       EndProperty
  360.       ForeColor       =   &H00800000&
  361.       Height          =   510
  362.       Left            =   0
  363.       TabIndex        =   4
  364.       Top             =   4230
  365.       Width           =   2490
  366.    End
  367.    Begin VB.Line Line2 
  368.       BorderColor     =   &H00E0E0E0&
  369.       X1              =   0
  370.       X2              =   744
  371.       Y1              =   34
  372.       Y2              =   34
  373.    End
  374.    Begin VB.Line Line1 
  375.       BorderColor     =   &H00808080&
  376.       X1              =   0
  377.       X2              =   744
  378.       Y1              =   33
  379.       Y2              =   33
  380.    End
  381.    Begin VB.Label Label1 
  382.       BackColor       =   &H00C0C0C0&
  383.       BorderStyle     =   1  'Fixed Single
  384.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  385.          Name            =   "MS Sans Serif"
  386.          Size            =   9.75
  387.          Charset         =   0
  388.          Weight          =   700
  389.          Underline       =   0   'False
  390.          Italic          =   0   'False
  391.          Strikethrough   =   0   'False
  392.       EndProperty
  393.       ForeColor       =   &H00800000&
  394.       Height          =   330
  395.       Left            =   2820
  396.       TabIndex        =   3
  397.       Top             =   75
  398.       Width           =   8310
  399.    End
  400.    Begin VB.Menu mnuFile 
  401.       Caption         =   ""
  402.       Visible         =   0   'False
  403.       Begin VB.Menu mnuSaveAs 
  404.          Caption         =   "Save Icon As"
  405.       End
  406.       Begin VB.Menu mnubar0 
  407.          Caption         =   "-"
  408.       End
  409.       Begin VB.Menu mnuMove 
  410.          Caption         =   "Move Icon"
  411.       End
  412.       Begin VB.Menu mnubar1 
  413.          Caption         =   "-"
  414.       End
  415.       Begin VB.Menu mnuDelete 
  416.          Caption         =   "Delete Icon"
  417.       End
  418.       Begin VB.Menu mnubar2 
  419.          Caption         =   "-"
  420.       End
  421.       Begin VB.Menu mnuRenameIcon 
  422.          Caption         =   "Rename Icon"
  423.       End
  424.    End
  425. Attribute VB_Name = "IconBook"
  426. Attribute VB_Creatable = False
  427. Attribute VB_Exposed = False
  428. Private Sub Newdir() 'Make new dir
  429. On Error GoTo mkdir0
  430. Inp1 = InputBox("Type the name of the new directory" & vbCr & "you want to create.", "IconAlbumDeluxe - New directory")
  431. If Inp1 = "" Then Exit Sub
  432. MkDir IBpath$ & "\" & Inp1
  433. Dir1.Refresh
  434. Pic2.SetFocus
  435. Exit Sub
  436. mkdir0:
  437. Message = MsgBox("Cannot create the directory: " & Temp$ & vbCr & vbCr & "That directory already exists !", vbOKOnly + vbInformation, "IconAlbum Deluxe - System Message")
  438. End Sub
  439. Private Sub Search()
  440. SearchForm.Show 1
  441. Pic2.SetFocus
  442. End Sub
  443. Private Sub Dir1_Change()
  444. Dir1.Path = IBpath
  445. End Sub
  446. Private Sub Dir1_Click()
  447. Label3.Caption = ""
  448. Label4.Caption = "No icon selected"
  449. Pic3.Picture = LoadPicture("")
  450. Image1.Picture = LoadPicture("")
  451. File1.Path = Dir1.List(Dir1.ListIndex)
  452. If File1.ListCount <= 240 Then
  453. Idx% = File1.ListCount - 1
  454. Idx% = 239
  455. Message = MsgBox("This map contains more than 240 icons..." & vbCr & "Only 240 icons will be shown !" & vbCr & vbCr & "You better create onother map of the same object" & vbCr & "to store some of the icons in it...", vbOKOnly + vbInformation, "IconAlbum Deluxe - System Message")
  456. End If
  457. Label1.Caption = Dir1.List(Dir1.ListIndex)
  458. Label2.Caption = "Icons in map:" & vbCr & Idx% + 1
  459. DoEvents
  460. Screen.MousePointer = 11
  461. For xx% = 0 To Idx%
  462. If Right(File1.Path, 1) = "\" Then
  463. Im1(xx%).Picture = LoadPicture(File1.Path + File1.List(xx%))
  464. Im1(xx%).Picture = LoadPicture(File1.Path + "\" + File1.List(xx%))
  465. End If
  466. Im1(xx).Visible = True
  467. Next xx%
  468. Screen.MousePointer = 1
  469. If Idx < 239 Then
  470. For xx = Idx + 1 To 239
  471. Im1(xx%).Picture = LoadPicture("")
  472. Im1(xx).Visible = False
  473. Next xx
  474. End If
  475. End Sub
  476. Private Sub Form_Activate()
  477. 'Pic2.SetFocus
  478. End Sub
  479. Private Sub Form_Load()
  480. Dim HelpTxt$
  481. IBpath = App.Path
  482. IconBook.Move (Screen.Width - IconBook.Width) / 2, (Screen.Height - IconBook.Height) / 2
  483. Label4.Caption = "No icon selected"
  484. For xx = 0 To 6
  485. Tool1(xx).Picture = Image2(xx).Picture
  486. Next xx
  487. For xx = 1 To 239
  488. Load Im1(xx%)
  489. Next xx
  490. For xx = 0 To 15
  491. Im1(xx%).Left = Im1(0).Left + (xx% * 35)
  492. Im1(xx% + 16).Left = Im1(0).Left + (xx% * 35)
  493. Im1(xx% + 32).Left = Im1(0).Left + (xx% * 35)
  494. Im1(xx% + 48).Left = Im1(0).Left + (xx% * 35)
  495. Im1(xx% + 64).Left = Im1(0).Left + (xx% * 35)
  496. Im1(xx% + 80).Left = Im1(0).Left + (xx% * 35)
  497. Im1(xx% + 96).Left = Im1(0).Left + (xx% * 35)
  498. Im1(xx% + 112).Left = Im1(0).Left + (xx% * 35)
  499. Im1(xx% + 128).Left = Im1(0).Left + (xx% * 35)
  500. Im1(xx% + 144).Left = Im1(0).Left + (xx% * 35)
  501. Im1(xx% + 160).Left = Im1(0).Left + (xx% * 35)
  502. Im1(xx% + 176).Left = Im1(0).Left + (xx% * 35)
  503. Im1(xx% + 192).Left = Im1(0).Left + (xx% * 35)
  504. Im1(xx% + 208).Left = Im1(0).Left + (xx% * 35)
  505. Im1(xx% + 224).Left = Im1(0).Left + (xx% * 35)
  506. Im1(xx%).Top = Im1(0).Top
  507. Im1(xx% + 16).Top = Im1(0).Top + 35
  508. Im1(xx% + 32).Top = Im1(0).Top + 70
  509. Im1(xx% + 48).Top = Im1(0).Top + 105
  510. Im1(xx% + 64).Top = Im1(0).Top + 140
  511. Im1(xx% + 80).Top = Im1(0).Top + 175
  512. Im1(xx% + 96).Top = Im1(0).Top + 210
  513. Im1(xx% + 112).Top = Im1(0).Top + 245
  514. Im1(xx% + 128).Top = Im1(0).Top + 280
  515. Im1(xx% + 144).Top = Im1(0).Top + 315
  516. Im1(xx% + 160).Top = Im1(0).Top + 350
  517. Im1(xx% + 176).Top = Im1(0).Top + 385
  518. Im1(xx% + 192).Top = Im1(0).Top + 420
  519. Im1(xx% + 208).Top = Im1(0).Top + 455
  520. Im1(xx% + 224).Top = Im1(0).Top + 490
  521. Next xx%
  522. Dir1.Path = IBpath
  523. For xx = 0 To 14
  524. Pic2.Line (Im1(xx).Left + 33, 0)-(Im1(xx).Left + 33, Pic2.ScaleHeight), RGB(170, 180, 170)
  525. Next xx
  526. For xx = 1 To 15
  527. Pic2.Line (0, Im1(0).Top - 1 + (xx * 35))-(Pic2.ScaleWidth, Im1(0).Top - 1 + (xx * 35)), RGB(170, 180, 170)
  528. Next xx
  529. End Sub
  530. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  531. End Sub
  532. Private Sub Form_Resize()
  533. IconBook.Width = 11295
  534. IconBook.Height = 9000
  535. End Sub
  536. Private Sub mnuDelete_Click()
  537. Message = MsgBox("Are you sure you want to delete the icon:" & vbCr & vbCr & Dir1.List(Dir1.ListIndex) & "\" & File1.List(IconIdx), vbOKCancel + vbQuestion, "IconAlbum Deluxe - System Message")
  538. If Message = vbCancel Then Exit Sub
  539. Kill Dir1.List(Dir1.ListIndex) & "\" & File1.List(IconIdx%)
  540. File1.Refresh
  541. Dir1_Click
  542. End Sub
  543. Private Sub mnuMove_Click()
  544. Dim Oldpath$, Newpath$
  545. Oldpath$ = Dir1.List(Dir1.ListIndex)
  546. On Error GoTo mnuMove2
  547. Inp1 = InputBox("You want to move the icon:" & vbCr & Dir1.List(Dir1.ListIndex) & "\" & File1.List(IconIdx%) & vbCr & vbCr & "Type the name of the destination map:" & vbCr, "IconAlbumDeluxe - Move Icon")
  548. If Inp1 = "" Then Exit Sub
  549. FileCopy Oldpath$ & "\" & File1.List(IconIdx%), IBpath & "\" & Inp1 & "\" & File1.List(IconIdx%)
  550. Kill Oldpath & "\" & File1.List(IconIdx%)
  551. File1.Refresh
  552. Dir1_Click
  553. Exit Sub
  554. mnuMove2:
  555. If Err = 76 Then
  556. Message = MsgBox("The map " & Inp1 & " does not exist !" & vbCr & vbCr & "Do you want me to create it ?", vbOKCancel + vbQuestion, "IconAlbum Deluxe - System Message")
  557. If Message = vbCancel Then Exit Sub
  558. MkDir IBpath & "\" & Inp1
  559. Dir1.Refresh
  560. FileCopy Oldpath$ & "\" & File1.List(IconIdx%), IBpath & "\" & Inp1 & "\" & File1.List(IconIdx%)
  561. Kill Oldpath$ & "\" & File1.List(IconIdx%)
  562. File1.Refresh
  563. Dir1_Click
  564. Exit Sub
  565. End If
  566. Message = MsgBox("There's a copy error !", vbOKOnly + vbExclamation, "IconAlbum Deluxe - System Message")
  567. End Sub
  568. Private Sub mnuRenameIcon_Click()
  569. Dim Oldpath$, Newpath$
  570. Oldpath$ = Dir1.List(Dir1.ListIndex) & "\" & File1.List(IconIdx)
  571. On Error GoTo mnuMove2
  572. Inp1 = InputBox("You want to rename the icon:" & vbCr & Dir1.List(Dir1.ListIndex) & "\" & File1.List(IconIdx%) & vbCr & vbCr & "Type the new iconname (without the extention .ico)" & vbCr, "IconAlbumDeluxe - Rename Icon")
  573. If Inp1 = "" Then Exit Sub
  574. Newpath$ = Dir1.List(Dir1.ListIndex) & "\" & Inp1 & ".ico"
  575. Message = MsgBox("You want to rename the icon: " & vbCr & Oldpath$ & vbCr & "as " & Newpath$ & vbCr & vbCr & "Continue ?", vbOKCancel + vbQuestion, "IconAlbum Deluxe - System Message")
  576. If Message = vbCancel Then Exit Sub
  577. Name Oldpath$ As Newpath$
  578. File1.Refresh
  579. Dir1_Click
  580. Label3.Caption = File1.List(IconIdx%)
  581. Exit Sub
  582. mnuMove2:
  583. Message = MsgBox("Cannot rename the directory: " & vbCr & Oldpath$, vbOKOnly + vbExclamation, "IconAlbum Deluxe - System Message")
  584. End Sub
  585. Private Sub mnuSaveAs_Click()
  586. On Error GoTo NoSave
  587. ComD1.filename = File1.List(IconIdx%)
  588. ComD1.DialogTitle = "Save Icon"
  589. ComD1.ShowSave
  590. SavePicture Pic3.Picture, ComD1.filename
  591. NoSave:
  592. End Sub
  593. Private Sub Im1_Click(Index As Integer)
  594. 'Pic3.Width = Im1(Index).Width
  595. 'Pic3.Height = Im1(Index).Height
  596. IconIdx% = Index
  597. Pic3.Picture = LoadPicture(File1.Path + "\" + File1.List(IconIdx))
  598. Image1.Picture = LoadPicture(File1.Path + "\" + File1.List(IconIdx))
  599. Label3.Caption = File1.List(IconIdx%)
  600. Label4.Caption = Im1(Index).Width & " X " & Im1(Index).Height & " Icon"
  601. PopupMenu mnuFile, , Pic2.Left + Im1(Index).Left + 32, Pic2.Top + Im1(Index).Top + 32
  602. End Sub
  603. Private Sub RemoveDirectory()
  604. On Error GoTo Remove2
  605. Message = MsgBox("You want to remove the directory:" & vbCr & Dir1.List(Dir1.ListIndex) & vbCr & vbCr & "If the directory contains files," & vbCr & "it cannot be removed..." & vbCr & vbCr & "Do you wish to continue ?", vbOKCancel + vbQuestion, "IconAlbum Deluxe - System Message")
  606. If Message = vbCancel Then Exit Sub
  607. RmDir (Dir1.List(Dir1.ListIndex))
  608. Dir1.Refresh
  609. Exit Sub
  610. Remove2:
  611. Message = MsgBox("Cannot remove the directory: " & vbCr & Dir1.List(Dir1.ListIndex) & vbCr & vbCr & "The directory probably contains files...", vbOKOnly + vbExclamation, "IconAlbum Deluxe - System Message")
  612. End Sub
  613. Private Sub RenameDirectory()
  614. Dim Oldpath$, Newpath$
  615. Oldpath$ = Dir1.List(Dir1.ListIndex)
  616. On Error GoTo Rename2
  617. Inp1 = InputBox("You want to rename the directory:" & vbCr & Oldpath$ & vbCr & vbCr & "Type the new name of the map:", "IconAlbumDeluxe - Rename directory")
  618. If Inp1 = "" Then Exit Sub
  619. For xx = Len(Oldpath$) To 1 Step -1
  620.     If Mid(Oldpath$, xx, 1) = "\" Then
  621.     Newpath$ = Left(Oldpath$, xx)
  622.     Exit For
  623.     End If
  624. Next xx
  625. Newpath$ = Newpath$ & Inp1
  626. Temp = MsgBox("You want to rename the directory: " & vbCr & Oldpath$ & vbCr & "as " & Newpath$ & vbCr & vbCr & "Continue ?", vbOKCancel + vbQuestion, "IconAlbum Deluxe - System Message")
  627. If Temp = vbCancel Then Exit Sub
  628. Name Oldpath$ As Newpath$
  629. Dir1.Refresh
  630. Exit Sub
  631. Rename2:
  632. Temp = MsgBox("Cannot rename the directory: " & vbCr & Oldpath$, vbOKOnly + vbExclamation, "IconAlbum Deluxe - System Message")
  633. End Sub
  634. Private Sub KillAll()
  635. Dim Tel%
  636. Temp = MsgBox("Remove all icons from the directory: " & vbCr & Dir1.List(Dir1.ListIndex), vbOKCancel + vbQuestion, "IconAlbum Deluxe - System Message")
  637. If Temp = vbCancel Then Exit Sub
  638. Tel% = File1.ListCount
  639. Screen.MousePointer = 11
  640. For xx = 0 To File1.ListCount - 1
  641. Kill Dir1.List(Dir1.ListIndex) & "\" & File1.List(xx)
  642. Next xx
  643. Screen.MousePointer = 1
  644. File1.Refresh
  645. Dir1_Click
  646. Temp = MsgBox("Just killed " & Tel & " Icons...", vbOKOnly + vbExclamation, "IconAlbum Deluxe - System Message")
  647. End Sub
  648. Private Sub CopyAll()
  649. Dim Oldpath$, Newpath$
  650. Oldpath$ = Dir1.List(Dir1.ListIndex)
  651. On Error GoTo mnuMove2
  652. Inp1 = InputBox("You want to move the whole map:" & vbCr & Dir1.List(Dir1.ListIndex) & vbCr & vbCr & "Type the name of the destination map:" & vbCr, "IconAlbumDeluxe - Move Icon")
  653. If Inp1 = "" Then Exit Sub
  654. Screen.MousePointer = 11
  655. For xx = 0 To File1.ListCount - 1
  656. FileCopy Oldpath$ & "\" & File1.List(xx), IBpath & "\" & Inp1 & "\" & File1.List(xx)
  657. Kill Oldpath & "\" & File1.List(xx)
  658. Next xx
  659. Screen.MousePointer = 1
  660. File1.Refresh
  661. Dir1_Click
  662. Exit Sub
  663. mnuMove2:
  664. Screen.MousePointer = 1
  665. Temp = MsgBox("There's a copy error !", vbOKOnly + vbExclamation, "IconAlbum Deluxe - System Message")
  666. End Sub
  667. Private Sub Tool1_Click(Index As Integer)
  668. If Index = 0 Then Newdir
  669. If Index = 1 Then RenameDirectory
  670. If Index = 2 Then RemoveDirectory
  671. If Index = 3 Then KillAll
  672. If Index = 4 Then CopyAll
  673. If Index = 5 Then Search
  674. If Index = 6 Then HelpForm.Show 1
  675. End Sub
  676. Private Sub Tool1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  677. Tool1(Index).Picture = Image2(Index + 7).Picture
  678. End Sub
  679. Private Sub Tool1_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  680. Tool1(Index).Picture = Image2(Index).Picture
  681. End Sub
  682.